Visual Basic Source Code

home *** CD-ROM | disk | FTP | other *** search

/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / calendar / form1.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1995-09-06 | 16.0 KB | 581 lines

VERSION 2.00 Begin Form frmcalendar BorderStyle = 1 'Fixed Single Caption = "Calendar" ClientHeight = 2865 ClientLeft = 930 ClientTop = 1485 ClientWidth = 4290 ControlBox = 0 'False Height = 3270 Icon = FORM1.FRX:0000 Left = 870 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 2865 ScaleWidth = 4290 Top = 1140 Width = 4410 Begin ComboBox cboyear Height = 300 Left = 2880 Style = 2 'Dropdown List TabIndex = 3 Top = 360 Width = 1215 End Begin ComboBox cbomonth Height = 300 Left = 120 Style = 2 'Dropdown List TabIndex = 1 Top = 360 Width = 2415 End Begin CommandButton cmdcancel Cancel = -1 'True Caption = "&Cancel" Height = 345 Left = 3000 TabIndex = 5 Top = 2400 Width = 1215 End Begin CommandButton cmdok Caption = "&OK" Default = -1 'True Height = 345 Left = 3000 TabIndex = 4 Top = 1965 Width = 1215 End Begin Label lbldate Alignment = 2 'Center ForeColor = &H00000080& Height = 615 Left = 2880 TabIndex = 38 Top = 1200 Width = 1215 End Begin Label lblday Alignment = 2 'Center ForeColor = &H00000080& Height = 255 Left = 2880 TabIndex = 37 Top = 1000 Width = 1215 End Begin Label lblnumber Alignment = 2 'Center Caption = "29" Height = 285 Index = 28 Left = 240 TabIndex = 7 Top = 2400 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "30" Height = 285 Index = 29 Left = 600 TabIndex = 8 Top = 2400 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "31" Height = 285 Index = 30 Left = 960 TabIndex = 9 Top = 2400 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "16" Height = 285 Index = 15 Left = 600 TabIndex = 10 Top = 1680 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "17" Height = 285 Index = 16 Left = 960 TabIndex = 11 Top = 1680 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "18" Height = 285 Index = 17 Left = 1320 TabIndex = 12 Top = 1680 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "19" Height = 285 Index = 18 Left = 1680 TabIndex = 13 Top = 1680 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "20" Height = 285 Index = 19 Left = 2040 TabIndex = 36 Top = 1680 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "21" Height = 285 Index = 20 Left = 2400 TabIndex = 35 Top = 1680 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "15" Height = 285 Index = 14 Left = 240 TabIndex = 34 Top = 1680 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "23" Height = 285 Index = 22 Left = 600 TabIndex = 33 Top = 2040 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "24" Height = 285 Index = 23 Left = 960 TabIndex = 32 Top = 2040 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "25" Height = 285 Index = 24 Left = 1320 TabIndex = 31 Top = 2040 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "26" Height = 285 Index = 25 Left = 1680 TabIndex = 30 Top = 2040 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "27" Height = 285 Index = 26 Left = 2040 TabIndex = 29 Top = 2040 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "28" Height = 285 Index = 27 Left = 2400 TabIndex = 28 Top = 2040 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "22" Height = 285 Index = 21 Left = 240 TabIndex = 27 Top = 2040 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "9" Height = 285 Index = 8 Left = 600 TabIndex = 26 Top = 1320 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "10" Height = 285 Index = 9 Left = 960 TabIndex = 25 Top = 1320 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "11" Height = 285 Index = 10 Left = 1320 TabIndex = 24 Top = 1320 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "12" Height = 285 Index = 11 Left = 1680 TabIndex = 23 Top = 1320 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "13" Height = 285 Index = 12 Left = 2040 TabIndex = 22 Top = 1320 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "14" Height = 285 Index = 13 Left = 2400 TabIndex = 21 Top = 1320 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "8" Height = 285 Index = 7 Left = 240 TabIndex = 20 Top = 1320 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "2" Height = 285 Index = 1 Left = 600 TabIndex = 19 Top = 960 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "3" Height = 285 Index = 2 Left = 960 TabIndex = 18 Top = 960 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "4" Height = 285 Index = 3 Left = 1320 TabIndex = 17 Top = 960 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "5" Height = 285 Index = 4 Left = 1680 TabIndex = 16 Top = 960 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "6" Height = 285 Index = 5 Left = 2040 TabIndex = 15 Top = 960 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "7" Height = 285 Index = 6 Left = 2400 TabIndex = 14 Top = 960 Width = 300 End Begin Label lblnumber Alignment = 2 'Center Caption = "1" Height = 285 Index = 0 Left = 240 TabIndex = 6 Top = 960 Width = 300 End Begin Shape Shape1 Height = 1935 Left = 120 Top = 840 Width = 2655 End Begin Label Label1 Caption = "&Year" Height = 255 Index = 1 Left = 2880 TabIndex = 2 Top = 120 Width = 495 End Begin Label Label1 Caption = "&Month" Height = 255 Index = 0 Left = 120 TabIndex = 0 Top = 120 Width = 615 End 'This code has been developed for EVERYONE'S use ' don't re-distribute this without ALL original files!! 'Phil Jones 1994 Option Explicit Dim selectedate% Sub cbomonth_click () Call setday Call lblnumber_click(selectedate% - 1) End Sub Sub cboyear_Click () Static once% ' get rid of first click event If Not once Then once = True Exit Sub End If Call cbomonth_click End Sub Sub checkdate (month1%, year1%) Dim i%, value%, date1$ For i% = 28 To 32 date1$ = (Str$(month1%) + "/" + Str$(i%) + "/" + Str$(year1%)) If IsDate(date1$) Then value% = i% Else Call displaynumbers(value%) Exit Sub End If Next i% End Sub Sub CmdCancel_Click () Unload frmcalendar End Sub Sub cmdOK_Click () Dim month1%, day1%, year1%, date1$ day1% = selectedate% month1% = cbomonth.ListIndex + 1 year1% = cboyear.ListIndex + 1960 date1$ = (Str$(month1%) + "/" + Str$(day1%) + "/" + Str$(year1%)) date1$ = Format$(date1$, "general date") MsgBox Format$(date1$, "long date") 'do whatever here to pass the date where 'you need it! End Sub Function determinemonth% () Dim i% i% = cbomonth.ListIndex'which month is selected? determinemonth% = i% + 1 End Function Function determineyear% () Dim i% i% = cboyear.ListIndex'which year was selected? If i% = -1 Then Exit Function'problem!! determineyear% = CInt(Trim(cboyear.List(i%))) End Function Sub displaynumbers (number%) Dim i% For i% = 28 To 30 lblnumber(i%).Visible = False Next i% For i% = 28 To number% - 1 lblnumber(i%).Visible = True Next i% End Sub Sub fillcbomonth () cbomonth.AddItem "January" cbomonth.AddItem "February" cbomonth.AddItem "March" cbomonth.AddItem "April" cbomonth.AddItem "May" cbomonth.AddItem "June" cbomonth.AddItem "July" cbomonth.AddItem "August" cbomonth.AddItem "September" cbomonth.AddItem "October" cbomonth.AddItem "November" cbomonth.AddItem "December" End Sub Sub fillcboyear () Dim i% For i% = 1960 To 2060'put whatever years tyou want here, cboyear.AddItem Str$(i%)'but don't forget to also change the code in setdate Next i% End Sub Sub Form_Load () selectedate% = CInt(Format$(Now, "dd")) 'fill month combo box Call fillcbomonth 'fill year combo box Call fillcboyear 'put current date and year im combo box Call setdate 'set current name for day Dim r%, caption1$ r% = Weekday(Format$(Now, "general date")) If r% = 1 Then caption1$ = "Sunday" ElseIf r% = 2 Then caption1 = "Monday" ElseIf r% = 3 Then caption1 = "Tuesday" ElseIf r% = 4 Then caption1 = "Wednesday" ElseIf r% = 5 Then caption1 = "Thursday" ElseIf r% = 6 Then caption1 = "Friday" caption1 = "Saturday" End If lblday.Caption = caption1$ End Sub Sub lblnumber_click (Index As Integer) Dim i% On Error GoTo err1 For i% = 0 To 30 lblnumber(i%).BorderStyle = 0 Next i% If lblnumber(Index).BorderStyle = 1 Then lblnumber(Index).BorderStyle = 0 lblnumber(Index).BorderStyle = 1 End If selectedate% = Index + 1 Dim month1%, day1%, year1%, date1$ day1% = selectedate% month1% = cbomonth.ListIndex + 1 year1% = cboyear.ListIndex + 1960 date1$ = (Str$(month1%) + "/" + Str$(day1%) + "/" + Str$(year1%)) 'date1$ = Format$(date1$, "general date") Dim r% Dim caption1$ r% = Weekday(date1$) If r% = 1 Then caption1$ = "Sunday" ElseIf r% = 2 Then caption1 = "Monday" ElseIf r% = 3 Then caption1 = "Tuesday" ElseIf r% = 4 Then caption1 = "Wednesday" ElseIf r% = 5 Then caption1 = "Thursday" ElseIf r% = 6 Then caption1 = "Friday" caption1 = "Saturday" End If lblday.Caption = caption1$ lbldate.Caption = Format$(date1$, "long date") err1: If Err = 0 Then Exit Sub If Err = 13 Then selectedate% = selectedate% - 1 Exit Sub End If End Sub Sub setdate () 'since the list starts at 1960, this is 0, so we're going ' to get the date, and subtract 1960 from it, and use this 'as our starting listindex 'put whatever value you need to for the first year 'year Dim r%, i% r% = CInt(Format$(Now, "yyyy")) i% = r% - 1960 cboyear.ListIndex = i% 'month r% = CInt(Format$(Now, "mm")) cbomonth.ListIndex = (r% - 1) r% = CInt(Format$(Now, "dd")) lblnumber(r% - 1).BorderStyle = 1 selectedate% = r% End Sub Sub setday () Dim month1%, year1% month1% = determinemonth() year1% = determineyear() Call checkdate(month1%, year1%) End Sub